home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / MSGDIR.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-13  |  14KB  |  359 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  7-23-88 3:57 pm 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit MsgDir;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   TPCrt, Globals, Core1, NetMisc,
  19.   TPSTRING, TPDOS, Core2;
  20.   
  21.   
  22. procedure mesg_directory;
  23.  
  24.  
  25.   {==========================================================================}
  26.   
  27.   
  28. Implementation
  29.  
  30.  
  31.   procedure mesg_directory;
  32.     { Display directory of messages }
  33.     
  34.   type
  35.     buftype         = array[1..1] of fido_summ_rec;
  36.     bufptr          = ^buftype;
  37.     
  38.   var
  39.     buffer          : bufptr;
  40.     col_width,
  41.     col_count,
  42.     col_limit,
  43.     conf_num,
  44.     msg_high,
  45.     msg_total, i    : Integer;
  46.     record_count    : LongInt;
  47.     This            : AreaPtr;
  48.     temstr          : string[160];
  49.     found,
  50.     found_msg_to,
  51.     found_msg_from,
  52.     wrote_lfcr,
  53.     first_pass      : Boolean;
  54.     ThisP, LastP    : NetAreaPtr;
  55.     summary_file    : untype_file;
  56.     
  57.   begin                           {msg_directory}
  58.     col_width := 6;
  59.     abort := False;
  60.     col_limit := max(1, user_rec.columns div col_width);
  61.     Write(Com, hi);
  62.     if (AreaReq[1] <> '-') and (AreaReq <> 'NETMAIL') then
  63.       begin
  64.         WriteLn(Com, yellow, 'Message numbers, this area  : ', msg_lo, '-', msg_hi);
  65.         WriteLn(Com, 'Public messages, this area  : ', msg_all, cyan);
  66.         WriteLn(Com);
  67.         if msg_ind = 0 then
  68.           WriteLn(Com, yellow, 'No messages addressed to you in this area.', cyan)
  69.         else
  70.           begin
  71.             WriteLn(Com, yellow, 'The following messages are addressed to you:', cyan);
  72.             col_count := 0;
  73.             MesgCurr := MesgBase;
  74.             while (not brk) and (MesgCurr <> nil) do
  75.               begin
  76.                 if MesgCurr^.TypMsg = 1 then
  77.                   begin
  78.                     Write(Com, MesgCurr^.MesgNo:col_width);
  79.                     Inc(col_count);
  80.                     if (0 = col_count mod col_limit) then
  81.                       WriteLn(Com)
  82.                   end;
  83.                 MesgCurr := MesgCurr^.next
  84.               end;
  85.             WriteLn(Com)
  86.           end;
  87.         if msg_aut > 0 then
  88.           begin
  89.             WriteLn(Com);
  90.             WriteLn(Com, yellow, 'The following messages were sent by you:', cyan);
  91.             col_count := 0;
  92.             MesgCurr := MesgBase;
  93.             while (not brk) and (MesgCurr <> nil) do
  94.               begin
  95.                 if MesgCurr^.TypMsg = 2 then
  96.                   begin
  97.                     Write(Com, MesgCurr^.MesgNo:col_width);
  98.                     Inc(col_count);
  99.                     if (0 = col_count mod col_limit) then
  100.                       WriteLn(Com)
  101.                   end;
  102.                 MesgCurr := MesgCurr^.next
  103.               end;
  104.             WriteLn(Com);
  105.           end;
  106.       end
  107.     else
  108.       begin
  109.         if AreaReq = 'NETMAIL' then
  110.           FidoArea := fidomail
  111.         else
  112.           FidoArea := fidomail+'\'+AreaReq;
  113.         SetSect(FidoArea);
  114.         fido_sort(msg_high, msg_total, msg_numbers);
  115.         SetSect(FidoArea);
  116.         WriteLn(Com, yellow, 'Message numbers, this area  : ', msg_numbers[1], '-', msg_high);
  117.         WriteLn(Com, 'Total messages,  this area  : ', msg_total, cyan);
  118.         WriteLn(Com);
  119.         if ExistFile('ORIGIN') then
  120.           begin
  121.             Assign(orig_file, 'ORIGIN');
  122.             Reset(orig_file);
  123.             ReadLn(orig_file, sect_orig);
  124.             sect_orig := ' * Origin: '+sect_orig+' ('+my_zone+':'+my_net+'/'+my_node+')'
  125.             +CR+LF;
  126.             Close(orig_file);
  127.           end
  128.         else
  129.           sect_orig := orig_line;
  130.         if ExistFile(nsum_name+ext) then
  131.           begin
  132.             Assign(fido_summ_file, nsum_name+ext);
  133.             Reset(fido_summ_file);
  134.             found_msg_to := False;
  135.             if FileSize(fido_summ_file) > 0 then
  136.               while (not EoF(fido_summ_file)) and (not found_msg_to) do
  137.                 begin
  138.                   Read(fido_summ_file, summary_record);
  139.                   found_msg_to := (summary_record.to_loc = user_loc);
  140.                 end;
  141.             if (not found_msg_to) then
  142.               WriteLn(Com, yellow, 'No messages addressed to you in this area.', cyan)
  143.             else
  144.               begin
  145.                 WriteLn(Com, yellow);
  146.                 WriteLn(Com, 'The following messages are addressed to you:', cyan);
  147.                 col_count := 0;
  148.                 Write(Com, summary_record.number:col_width);
  149.                 Inc(col_count);
  150.                 while (not EoF(fido_summ_file)) do
  151.                   begin
  152.                     Read(fido_summ_file, summary_record);
  153.                     found_msg_to := (summary_record.to_loc = user_loc);
  154.                     if found_msg_to then
  155.                       begin
  156.                         Write(Com, summary_record.number:col_width);
  157.                         Inc(col_count);
  158.                         if (0 = col_count mod col_limit) then
  159.                           WriteLn(Com)
  160.                       end;
  161.                   end;
  162.                 WriteLn(Com)
  163.               end;
  164.             Seek(fido_summ_file, 0);
  165.             found_msg_from := False;
  166.             if FileSize(fido_summ_file) > 0 then
  167.               while (not EoF(fido_summ_file)) and (not found_msg_from) do
  168.                 begin
  169.                   Read(fido_summ_file, summary_record);
  170.                   found_msg_from := (summary_record.from_loc = user_loc);
  171.                 end;
  172.             if found_msg_from then
  173.               begin
  174.                 WriteLn(Com, yellow);
  175.                 WriteLn(Com, 'The following messages were sent by you:', cyan);
  176.                 col_count := 0;
  177.                 Write(Com, summary_record.number:col_width);
  178.                 Inc(col_count);
  179.                 while (not EoF(fido_summ_file)) do
  180.                   begin
  181.                     Read(fido_summ_file, summary_record);
  182.                     found_msg_from := (summary_record.from_loc = user_loc);
  183.                     if found_msg_from then
  184.                       begin
  185.                         Write(Com, summary_record.number:col_width);
  186.                         Inc(col_count);
  187.                         if (0 = col_count mod col_limit) then
  188.                           WriteLn(Com)
  189.                       end;
  190.                   end;
  191.                 WriteLn(Com)
  192.               end;
  193.             Close(fido_summ_file);
  194.           end;
  195.       end;
  196.       
  197.     if UserWantsScan then
  198.       begin
  199.         first_pass := True;
  200.         Seek(summ_file, 1);       {look for msgs in other areas}
  201.         col_count := 0;
  202.         col_width := 12;
  203.         temstr := '';
  204.         col_limit := max(1, user_rec.columns div col_width);
  205.         found := False;
  206.         while not EoF(summ_file) do
  207.           with summ_rec do
  208.             begin
  209.               Read(summ_file, summ_rec);
  210.               if (status <> deleted) and (Area <> AreaSet) and (user_loc = user_to) then
  211.                 begin
  212.                   This := AreaBase;
  213.                   while (This <> nil) and (This^.Area <> Area) do
  214.                     This := This^.next;
  215.                   conf_num := This^.AreaConf and 7;
  216.                   if (Pos(This^.AreaName, temstr) = 0) and (This <> nil) and ((user_rec.access
  217.                     >= This^.AreaAccs) or
  218.                     (test_bit(user_rec.conf_flags, conf_num))) then
  219.                     begin
  220.                       wrote_lfcr := False;
  221.                       if first_pass then
  222.                         begin
  223.                           first_pass := False;
  224.                           WriteLn(Com);
  225.                         end;
  226.                       found := True;
  227.                       Write(Com, This^.AreaName:col_width);
  228.                       Inc(col_count);
  229.                       temstr := temstr+This^.AreaName;
  230.                       if (0 = col_count mod col_limit) then
  231.                         begin
  232.                           WriteLn(Com);
  233.                           wrote_lfcr := True;
  234.                         end;
  235.                     end;
  236.                 end;
  237.             end;                  {reading summary file}
  238.         This := AreaBase;
  239.         
  240.         if first_scan then
  241.           begin
  242.             ThisP := NetAreaBase;
  243.             while ThisP <> nil do
  244.               begin
  245.                 LastP := ThisP;
  246.                 ThisP := ThisP^.next;
  247.                 Dispose(LastP);
  248.               end;
  249.             repeat
  250.               found_msg_to := False;
  251.               while (This <> nil) and (This^.AreaName[1] <> '-') and (This^.AreaName <> 'NETMAIL') do
  252.                 This := This^.next;
  253.               conf_num := This^.AreaConf and 7;
  254.               if ((This <> nil) and ((user_rec.access >= This^.AreaAccs) or
  255.                 (test_bit(user_rec.conf_flags, conf_num)))) and (This^.AreaName <> AreaReq) then
  256.                 begin
  257.                   if This^.AreaName = 'NETMAIL' then
  258.                     FidoArea := fidomail
  259.                   else
  260.                     FidoArea := fidomail+'\'+This^.AreaName;
  261.                   SetSect(FidoArea);
  262.                   if ExistFile(nsum_name+ext) then
  263.                     begin
  264.                       Assign(summary_file, nsum_name+ext);
  265.                       Reset(summary_file, SizeOf(fido_summ_rec));
  266.                       record_count := FileSize(summary_file);
  267.                       GetMem(buffer, record_count*SizeOf(summary_record));
  268.                       i := 1;
  269.                       if record_count > 0 then
  270.                         begin
  271.                           BlockRead(summary_file, buffer^, record_count);
  272.                           while (i <= record_count) and (not found_msg_to) do
  273.                             begin
  274.                               summary_record := buffer^[i];
  275.                               Inc(i);
  276.                               found_msg_to := (summary_record.to_loc = user_loc);
  277.                               if found_msg_to then
  278.                                 begin
  279.                                   wrote_lfcr := False;
  280.                                   if first_pass then
  281.                                     begin
  282.                                       first_pass := False;
  283.                                       WriteLn(Com);
  284.                                     end;
  285.                                   temstr := This^.AreaName;
  286.                                   if temstr[1] = '-' then
  287.                                     Delete(temstr, 1, 1);
  288.                                   Write(Com, temstr:col_width);
  289.                                   FreeMem(buffer, record_count*SizeOf(summary_record));
  290.                                   New(ThisP);
  291.                                   if NetAreaBase = nil then
  292.                                     NetAreaBase := ThisP
  293.                                   else
  294.                                     LastP^.next := ThisP;
  295.                                   LastP := ThisP;
  296.                                   LastP^.AreaName := temstr;
  297.                                   LastP^.next := nil;
  298.                                   Inc(col_count);
  299.                                   if (0 = col_count mod col_limit) then
  300.                                     begin
  301.                                       WriteLn(Com);
  302.                                       wrote_lfcr := True;
  303.                                     end;
  304.                                   found := True;
  305.                                 end;
  306.                             end;
  307.                           if (not found_msg_to) then
  308.                             FreeMem(buffer, record_count*SizeOf(summary_record));
  309.                         end;
  310.                       Close(summary_file);
  311.                     end;
  312.                 end;
  313.               if this <> nil then This := This^.next;
  314.             until This = nil;
  315.           end
  316.         else
  317.           begin
  318.             ThisP := NetAreaBase;
  319.             while ThisP <> nil do
  320.               begin
  321.                 temstr := ThisP^.AreaName;
  322.                 if not((Pos(temstr, AreaReq) = 2) or (temstr = AreaReq)) then
  323.                   begin
  324.                     wrote_lfcr := False;
  325.                     if first_pass then
  326.                       begin
  327.                         first_pass := False;
  328.                         WriteLn(Com);
  329.                       end;
  330.                     found := True;
  331.                     Write(Com, temstr:col_width);
  332.                     Inc(col_count);
  333.                     if (0 = col_count mod col_limit) then
  334.                       begin
  335.                         WriteLn(Com);
  336.                         wrote_lfcr := True;
  337.                       end;
  338.                   end;
  339.                 ThisP := ThisP^.next;
  340.               end;
  341.           end;
  342.         if found then
  343.           begin
  344.             if (not wrote_lfcr) then
  345.               WriteLn(Com);
  346.             WriteLn(Com, yellow, 'Above are other Areas with messages for you.')
  347.           end
  348.         else if first_scan then
  349.           WriteLn(Com, yellow, 'No messages found for you in other areas.');
  350.         first_scan := False;
  351.       end;
  352.     SetSect(HomName);
  353.     WriteLn(Com, cyan);
  354.   end;
  355.   
  356.   
  357. end.                              { of MSGDIR.PAS}
  358. 
  359.